perm filename HEADER.SAI[PNT,HE]6 blob
sn#456531 filedate 1979-07-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DEFINE VERSION!NUMBER = 7 COMMENT CHANGE THIS EACH TIME YOU MAKE ANY NEW
C00003 00003 defining constants and compile time macros to declare internal external etc
C00007 00004 defining default compile flags for $MAINPR
C00010 00005 ! IOSAIL debugging package
C00013 00006 ! global definitions of flags and other constants
C00018 00007 ! record class and pointer definitions
C00023 00008 ! procedure declarations
C00038 00009 ! variable declarations
C00045 00010 ! file requirements
C00047 ENDMK
C⊗;
DEFINE VERSION!NUMBER = 7 ; COMMENT CHANGE THIS EACH TIME YOU MAKE ANY NEW
CHANGES TO THIS FILE ***** ;
REQUIRE VERSION!NUMBER VERSION;
COMMENT defining constants and compile time macros to declare internal external etc;
DEFINE π = "3.141592653";
DEFINE ALT ="'775",
SEMC = "'73",
SP = "'40",
CR = "'15",
LF ="'12",
CRLF = "('15&'12)",
DLF = "('15&'12&'12)",
TAB = "'11",
FF = "'14",
! = "COMMENT ",
TV = "'13",
α = "BEGIN",
β = "END",
RUBOUT = "'177",
DQUOTE = "'42";
DEFINE TABDEF "[]" = [" "];
! if /nB is set in the command line then assume he wants a debugging parser;
require "<><>" delimiters;
IFC ¬DECLARATION(#DEBUG) THENC
DEFINE
DECIPHER_DEBUG(A)=<
ASSIGNC A=CVMS(COMPILER!BANNER)[2 TO ∞-1];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), LF, NULL, "IA"))+1 FOR ∞];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), TAB, NULL, "IA"))+1 FOR ∞];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), SP, NULL, "IA"))+1 FOR 1];
"A">;
IFC DECIPHER_DEBUG()="0"
THENC DEFINE #DEBUG=FALSE;
ELSEC DEFINE #DEBUG=TRUE;
EXTERNAL PROCEDURE BAIL;
EXTERNAL STRING !!QUERY;
ENDC
ENDC
DEFINE RCLASS "<>" = <RECORD_CLASS>;
DEFINE RPTR "<>" = <RECORD_POINTER>;
DEFINE RANY "<>" = <RECORD_POINTER(ANY_CLASS)>;
DEFINE ID_TYPE = 1,
INT_TYPE = 2,
REAL_TYPE = 3,
OPERATOR_TYPE = 4,
RES_TYPE = 5,
UNDECLARED_TYPE = 0;
! #TOKEN = ID_TYPE for identifier,
INT_TYPE for integer,
REAL_TYPE for real,
OPERATOR_TYPE for operators,
RES_TYPE for reserved words,
UNDECLARED_TYPE for not declared id's;
DEFINE #INDLK = 0; ! affix type = independent link;
DEFINE #NRGLK = 1; ! affix type = non rigid link;
DEFINE #RGDLK = 2; ! affix type = rigid link;
DEFINE #DEG = "(3.141592653/180.0)"; ! for radians/degrees conversion;
DEFINE DECLAR_VAR(DEC,I,E) "<>" =
< IFC I THENC INTERNAL DEC ; ELSEC
IFC E THENC EXTERNAL DEC ; ENDC ENDC > ;
DEFINE DECLAR_PROC(DEC,I,E) "<>" =
< IFC I THENC FORWARD INTERNAL DEC ; ELSEC
IFC E THENC EXTERNAL DEC ; ENDC ENDC > ;
DEFINE REQUIRE_LOADMODULE(FLAG, FILE) "<>" =
< IFC FLAG THENC
REQUIRE "FILE" LOAD_MODULE;
ENDC > ;
DEFINE MAX_OFFSET=1; ! max allowable offset ;
DEFINE CUR_OFFSET=2; ! current offset ;
DEFINE CON_OFFSET=3; ! constant offsets end here;
DEFINE ARM_OFFSET=4; ! arm offset starts here;
DEFINE PRG_OFFSET=5; ! program defined variables begin here;
DEFINE RES_OFFSET=6; ! reserved words table entries end here;
DEFINE YRM_ALOFFSET=0,
YHD_ALOFFSET=1,
BRM_ALOFFSET=2,
BHD_ALOFFSET=3;
comment defining default compile flags for $MAINPR;
IFCR NOT DECLARATION(#HELP) THENC DEFINE #HELP = TRUE; ENDC
! the program is compiled without
help facilities (?, complete error explanations,
syntax of the istructions..);
IFCR NOT DECLARATION(#WRIST) THENC DEFINE #WRIST = TRUE; ENDC
IFCR NOT DECLARATION(#GATHER) THENC DEFINE #GATHER = TRUE; ENDC
IFCR NOT DECLARATION(#DISPL) THENC DEFINE #DISPL = TRUE; ENDC
! the program is without the display;
IFCR NOT DECLARATION(#OUTPT) THENC DEFINE #OUTPT = TRUE; ENDC
! the progaam is without file I/O;
ifcr not declaration(#nofunct) thenc define #nofunct = true; endc
IFCR NOT DECLARATION(#INPUT) THENC DEFINE #INPUT = TRUE; ENDC
! the program is without arm interface;
IFCR NOT DECLARATION(#ARROW) THENC DEFINE #ARROW = TRUE; ENDC
! the program is without arm interface;
IFC ¬ #DISPL THENC REDEFINE #ARROW=FALSE; ENDC
DEFINE #INDEF = 0; ! #INDEF for not defined direction in input;
DEFINE #SORRY "<>" = <("sorry, not implemented "&CRLF)>;
! used for non implemented parts message;
DEFINE #NOTYET "<>" = <("yarm not yet available "&CRLF)>;
! used for non implemented parts message;
DEFINE #VERSION "<>" = <("instruction not available in this POINTY version "&CRLF)>;
! used for different version message;
! IOSAIL debugging package ;
! following taken from IOSAIL.HDR[107,BTH] and modified;
! macros BUGON, BUGOFF, DEBUG, boolean !bugoff;
! boolean !bugoff;
! define BUGON = {!bugoff:=false};
! define BUGOFF = {!bugoff:=true};
define !bugoff = false; ! INITIALLY DEBUG ON;
define BUGON "{}" = {redefine !bugoff = true ; };
define BUGOFF "{}" = {redefine !bugoff = false ; };
define DEBUG (where,arglist) "{}" = {
IFCR NOT !BUGOFF THENC
begin "DEBUG"
integer sf1,sf2;
getformat(sf1,sf2);
setformat(0,7);
redefine !bugind = 1;
print("DEBUG:where ");
ifc cvps(arglist) neq "("
thenc redefine !argl = {(arglist)};
elsec redefine !argl = {arglist}; endc
ifc length(cvms(!argl)) > 2 thenc
forlc !bugind := !argl doc {
print((cvps(!bugind) & "="),
ifc expr!type(!bugind) land check!type(string)
thenc """",!bugind,""""
elsec !bugind endc,
"; ");}
endc
endc
print(crlf);
setformat(sf1,sf2);
end "DEBUG"
ENDC };
! WARNING--!BUGIND and !ARGL are required by the debug package,
! and should not be otherwise used in this block
! to use:
! DEBUG(label,(i,j,k,l));
! alternate form:
! DEBUG(label,i);
! as long as i does not start with "(" this has the same effect as
! DEBUG(label,(i));
! global definitions of flags and other constants;
DEFINE #MIN = 1;
DEFINE #MAX = 7;
DEFINE #NTYPE = #MAX; ! 7 data types= 7 classes of records;
DEFINE #LTYPE = 70; ! number of elements for each type;
DEFINE DUMMY_DELIM=RUBOUT; ! used to delimit macro parameters;
DEFINE #SC = 1; ! SCALAR ;
DEFINE #VT = 2; ! VECTOR ;
DEFINE #RT = 3; ! ROT ;
DEFINE #TR = 4; ! TRANS ;
DEFINE #FRE= 4; ! frame expression ;
DEFINE #FR = 5; ! FRAME ;
DEFINE #MC = 6; ! MACRO ;
DEFINE #FN = 7; ! FUNCTION ;
DEFINE #EX = 8; ! EXPRESSION ;
DEFINE #SY = 9; ! SYMBOL ;
DEFINE #DTYPE= 10; ! # OF DATATYPES, INCREASE IF MORE RECORDS DEFINED;
DEFINE #PR = #FN;
DEFINE #SIMPLE = 0;
DEFINE #ARRAY = 1;
DEFINE #PROCEDURE = 2 ;
DEFINE TTY_X=1; ! TTY input ;
DEFINE DSK_X=2 ; ! DSK input ;
DEFINE QUERY_X=3 ; ! QUERY input ;
DEFINE MESSAGE_X=4; ! MESSAGE input by MAIL from other prog ;
DEFINE MAC_X=5; ! output from macro body;
DEFINE WR_M = 1; ! DSK output for macros;
DEFINE ED_M = 2; ! TTY output for editing macros;
DEFINE DS_M = 3; ! TTY output for displaying macros;
DEFINE TABLE_D=1,
FILE_D=2,
TYPE_D=3,
EDIT_D=4,
SYMBOL_D=5;
DEFINE #SCLTYP = 1; ! data type codes defined in the AL runtime system;
DEFINE #VECTYP = 2;
DEFINE #TRNTYP = 3;
DEFINE #EVNTYP = 4;
DEFINE #CMNTYP = 5;
DEFINE #HDRTYP = '400; ! Pointer to frame header ;
DEFINE #ARRTYP = '1000; ! Pointer to array header ;
DEFINE #REFTYP = '2000; ! Indirect pointer to entry in another environment;
DEFINE #PRCTYP = '4000; ! Pointer to procedure descriptor ;
DEFINE #MINUS1 = '177777; ! PDP11 representation of -1 ;
DEFINE #NONRGD = '400; ! code for nonrigid affixment;
DEFINE #EXPTRN = '2000; ! code for explicit trans used ;
IFCR NOT DECLARATION($MAINPR) THENC DEFINE $MAINPR = FALSE; ENDC
IFCR NOT DECLARATION($PARSER) THENC DEFINE $PARSER = FALSE; ENDC
IFCR NOT DECLARATION($$HELP) THENC DEFINE $$HELP = FALSE; ENDC
IFCR NOT DECLARATION($INPOUT) THENC DEFINE $INPOUT = FALSE; ENDC
IFCR NOT DECLARATION($OUTPUT) THENC DEFINE $OUTPUT = FALSE; ENDC
IFCR NOT DECLARATION($DISPLY) THENC DEFINE $DISPLY = FALSE; ENDC
IFCR NOT DECLARATION($INIT) THENC DEFINE $INIT = FALSE; ENDC
IFCR NOT DECLARATION($EXPR) THENC DEFINE $EXPR = FALSE; ENDC
IFCR NOT DECLARATION($MSSNGR) THENC DEFINE $MSSNGR = FALSE; ENDC
IFCR NOT DECLARATION($GATHER) THENC DEFINE $GATHER = FALSE; ENDC
IFCR NOT DECLARATION($PPCODE) THENC DEFINE $PPCODE = FALSE; ENDC
IFC ¬($MAINPR OR $PARSER OR $$HELP OR $INPOUT OR $OUTPUT OR $EXPR
OR $DISPLY OR $INIT OR $MSSNGR OR $GATHER OR $PPCODE) THENC
REQUIRE "
**********PROGRAM DOESN'T HAVE ID ****************
" MESSAGE;
ENDC
! record class and pointer definitions;
DECLAR_VAR(<RCLASS SYMBOL (STRING PNAME;
RANY OBJECT; ! rptr for further info;
INTEGER TYPE, ! #SC,#VT,#RT,#TR,#FR,#MC,#PR(UNTYPED);
ACCESS, ! #SIMPLE,#ARRAY,#PROCEDURE;
OFFSET, ! level offset ;
INDEX ! array index for simple variables ;
! INTEGER NUSEDBY,NUSES;
! BOOLEAN VALID; ! RANY ARRAY USEDBY,USES;)>,
$MAINPR, $PARSER∨$INPOUT∨$DISPLY∨$INIT∨$EXPR∨$MSSNGR∨$OUTPUT);
DECLAR_VAR(<RPTR(SYMBOL)ARRAY $YMTAB[1:#NTYPE,1:#LTYPE]>,
$MAINPR, $INPOUT∨$DISPLY∨$OUTPUT);
DECLAR_VAR(<RCLASS SYMTREE(RPTR(SYMBOL)SYM;
RPTR(SYMTREE)LLINK,RLINK)>, $MAINPR, $PARSER∨$EXPR);
DECLAR_VAR(<RCLASS BLOCKREC(RPTR(SYMTREE)TREE;
RPTR(BLOCKREC)NEXT;
INTEGER LEVEL,#ARGS)>, $MAINPR, $PARSER∨$EXPR);
DECLAR_VAR(<RPTR(BLOCKREC) CURBLOCK>, $MAINPR, $PARSER∨$EXPR);
DECLAR_VAR(<INTEGER ARRAY $ENTRY[1:#NTYPE]>, $MAINPR, $INPOUT∨$DISPLY∨$INIT∨$OUTPUT);
DECLAR_VAR(<RCLASS SCALAR (REAL VALUE)>, $MAINPR, $PARSER∨$INPOUT∨$DISPLY∨$INIT∨$EXPR∨$OUTPUT);
DECLAR_VAR(<RCLASS VECTOR (REAL XC,YC,ZC)>, $MAINPR, $PARSER∨$INPOUT∨$DISPLY∨$INIT∨$EXPR∨$OUTPUT);
DECLAR_VAR(<RCLASS FRAME (STRING PNAME;
RPTR (FRAME) DAD,SON,EBRO,YBRO; INTEGER HOWLINKED;
REAL ARRAY XF;
INTEGER BYOFFSET; RPTR(SYMBOL)SYM)>, $MAINPR,$PARSER∨$MSSNGR
∨$INPOUT∨$DISPLY
∨$INIT∨$EXPR∨$OUTPUT);
DECLAR_VAR(<RCLASS ROT (REAL ARRAY XF)>, $MAINPR, $PARSER∨$INPOUT∨$DISPLY∨$INIT∨$EXPR∨$OUTPUT);
DECLAR_VAR(<RCLASS TRANS(REAL ARRAY XF)>, $MAINPR, $PARSER∨$INPOUT∨$DISPLY∨$INIT∨$EXPR∨$OUTPUT);
DECLAR_VAR(<RCLASS GRAPHREC(REAL ARRAY DATA;
INTEGER SIZE,CTLBITS,NPNTS)>, $MAINPR, $EXPR∨$GATHER);
DECLAR_VAR(<RPTR(GRAPHREC) GRAPTR>, $MAINPR, $EXPR∨$GATHER);
DECLAR_VAR(<RCLASS WRISTREC(INTEGER ARRAY DATA)>, $MAINPR, $EXPR);
DECLAR_VAR(<RPTR(WRISTREC)WSTPTR>, $MAINPR, $EXPR);
DECLAR_VAR(<RCLASS ARRAYREC(INTEGER #DIM; INTEGER ARRAY LB,UB;
RANY ARRAY PTR)>, $MAINPR, $PARSER∨$EXPR∨$OUTPUT);
DECLAR_VAR(<RCLASS EXPR$(INTEGER #BODY,TYPE;INTEGER ARRAY BODY)>,
$EXPR, $MAINPR∨$INIT∨$MSSNGR∨$PPCODE);
DECLAR_VAR(<RCLASS PLIST(STRING PARAM; RPTR(PLIST) NEXTP)>,
$MAINPR, $PARSER∨$INPOUT∨$OUTPUT);
DECLAR_VAR(<RCLASS MACRO(STRING HEAD,BODY;INTEGER NPARAM;
STRING ARRAY PRLIST)>, $MAINPR, $PARSER∨$INPOUT∨$OUTPUT∨$DISPLY);
DECLAR_VAR(<RCLASS PROC(INTEGER NARGS;
STRING HEAD,BODY;STRING ARRAY ARGNAME;
INTEGER ARRAY ARGDIM,ARGTYPE,ARGACCS)>, $MAINPR,$PARSER∨$DISPLY∨$EXPR∨$OUTPUT);
DECLAR_VAR(<RPTR(SYMBOL)CURPROC>, $MAINPR, $EXPR∨$PARSER);
DECLAR_VAR(<RPTR (FUNCTION) FN_CUR>, FALSE, FALSE);
! pointers to predeclared symbols;
DECLAR_VAR(<RPTR(SYMBOL)HANDB,HANDY>, $MAINPR, $INIT∨$EXPR);
DECLAR_VAR(<RPTR(SYMBOL)BARM,YARM,BPARK,YPARK,BGRASP>, $MAINPR, $INIT∨$EXPR);
DECLAR_VAR(<RPTR(SYMBOL)WORLD>, $MAINPR, $INIT∨$INPOUT∨$EXPR);
DECLAR_VAR(<RPTR(FRAME)F_BARM,F_YARM,F_ARM>, $MAINPR, $INIT);
DECLAR_VAR(<RPTR(FRAME)F_WRLD>, $MAINPR, $INIT∨$DISPLY∨$INPOUT∨$EXPR);
! procedure declarations ;
! **** MAIN PROGRAM PROCEDURES ****** ;
DECLAR_PROC(<RPTR(FRAME) PROCEDURE GTFRAME(INTEGER LEVOFF,#DIM; INTEGER ARRAY DIM;
RPTR(SYMBOL)S)>, $MAINPR,$EXPR);
DECLAR_PROC(<INTERNAL INTEGER PROCEDURE ARRYDIM(INTEGER LEVOFF;
REFERENCE RPTR(SYMBOL) SYM)>, $MAINPR,$EXPR);
DECLAR_PROC(<RPTR(SYMBOL)PROCEDURE SEARCHBLOCK(STRING S; RPTR(BLOCKREC)R)>,
$MAINPR, $PARSER);
DECLAR_PROC(<RPTR(SYMBOL)PROCEDURE NWAREC(RPTR(SYMBOL)SYMB;INTEGER ARRAY LB,UB)>,
$MAINPR, $EXPR);
DECLAR_PROC(<procedure outdpw (string mess; integer string_pos, pp_pos)>,
FALSE, $MAINPR);
DECLAR_PROC(<PROCEDURE ADDSYMUSED(RPTR(SYMBOL)SYM,USES)>,false, FALSE);
DECLAR_PROC(<RPTR(SYMBOL) PROCEDURE CHECK(STRING SYMB; INTEGER NM)>,
$MAINPR, $INIT);
DECLAR_PROC(<RPTR(SYMBOL) PROCEDURE CHECKTOT(STRING SYMB)>,
$MAINPR, $PARSER);
DECLAR_PROC(<PROCEDURE READCODE(STRING FID; BOOLEAN ECHO(FALSE))>,
$MAINPR, $INIT);
DECLAR_PROC(<INTEGER PROCEDURE DECSTR(STRING S)>, $MAINPR, $PARSER);
DECLAR_PROC(<PROCEDURE ERROR(STRING ERR1,ERR2(NULL))>, $MAINPR, $PARSER∨$INPOUT∨$EXPR∨$MSSNGR∨$OUTPUT);
DECLAR_PROC(<PROCEDURE ESC_P>, $MAINPR, $PARSER∨$INPOUT);
DECLAR_PROC(<PROCEDURE ABORT1(STRING NAME,ERROR(NULL))>,$MAINPR, $INPOUT∨$PARSER);
DECLAR_PROC(<PROCEDURE UFX_NODE(RPTR(FRAME)EL1,EL2)>, $MAINPR, $EXPR);
DECLAR_PROC(<PROCEDURE AFX_NODE(RPTR(FRAME)N,D;INTEGER HOW)>, $MAINPR, $EXPR);
DECLAR_PROC(<STRING PROCEDURE FRCVER(STRING FILE)>, $MAINPR∧#OUTPT, $INPOUT);
DECLAR_PROC(<PROCEDURE UPDATE>, $MAINPR, $PARSER);
DECLAR_PROC(<RECURSIVE RPTR(EXPR$)PROCEDURE PARSE>, $MAINPR, $INIT);
DECLAR_PROC(<RPTR (SCALAR,VECTOR,ROT,FRAME,TRANS) PROCEDURE MK_REC(INTEGER TYPE)>,
$MAINPR, $INIT∨$EXPR);
DECLAR_PROC(<PROCEDURE ENSYM$(RPTR(SYMBOL)SYM; INTEGER NM(0))>,
$MAINPR, $EXPR);
DECLAR_PROC(<RPTR (SYMBOL) PROCEDURE ENSYM(STRING SYMB;INTEGER NM;
RANY VAL;RPTR(SYMBOL)OLDREC(NULL_RECORD);
INTEGER ACCESS(#SIMPLE))>, $MAINPR, $INIT);
DECLAR_PROC(<PROCEDURE CHKESC_I>, $MAINPR, $PARSER∨$MSSNGR);
DECLAR_PROC(<SIMPLE PROCEDURE ESC_I>, $MAINPR, $PARSER);
! **** FEXPR PROCEDURES ******* ;
DECLAR_PROC(<RANY PROCEDURE $EVAL11(RPTR(SYMBOL)SYM)>, $EXPR, $OUTPUT);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE PREF(RPTR(SYMBOL)S)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE IDREF(REFERENCE RPTR(SYMBOL)S)>,$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE AREF(RPTR(SYMBOL)S;INTEGER OPERATION)>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(expr$)PROCEDURE $$GTEXPR>, $EXPR, $MAINPR);
DECLAR_PROC(<RECURSIVE PROCEDURE $EXECUTE(RPTR(EXPR$)CUEXPR)>,
$EXPR, $MAINPR∨$INIT);
DECLAR_PROC(<RECURSIVE RPTR(EXPR$) PROCEDURE $$GTVEXPR>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE αEXPR$(INTEGER ARRAY BUFF;INTEGER TYPE)>,
$EXPR, $MAINPR∨$INIT);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE EXPR$1(INTEGER I(0))>,$EXPR, $MAINPR);
DECLAR_PROC(<RPTR (EXPR$)PROCEDURE EXPR$2(INTEGER I(0),J(0))>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE EXPR$3(INTEGER I(0),J(0),K(0))>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $APPEND(RPTR(EXPR$)E1,E2; INTEGER TYPE(0))>,
$EXPR, $INIT∨$MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $AAPPEND(RPTR(EXPR$) ARRAY APTR;INTEGER TYPE(0))>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $KVARPCODE(INTEGER N)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $RFORCEPCODE>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $RTNPCODE(RPTR(EXPR$)EXP)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $SMPDCLPCODE(INTEGER OBTYPE,J)>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $ARRDCLPCODE(STRING NAME;
RPTR(EXPR$) ARRAY BOUNDS; INTEGER OBTYPE,ADIM)>,$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $PRCDCLPCODE(RPTR(SYMBOL)SYM;
RPTR(EXPR$)PBODY)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $AFXPCODE(RPTR(EXPR$)SON,DAD; INTEGER AFFCODE;
RPTR(EXPR$)E1)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $CENTERPCODE(INTEGER ARM)>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $DDTPCODE>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $MOVEPCODE(RPTR(SYMBOL) S1,S2;RPTR(EXPR$)ARRAY FDESTS;
INTEGER NFDEST)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $DRIVEPCODE(INTEGER COLOR;STRING HOW;
INTEGER JOINT;RPTR(EXPR$)SCAL)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $ASGPCODE(RPTR(EXPR$) EXPR;
RPTR(SYMBOL)S)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $AASGPCODE(RPTR(EXPR$) E1,E2)>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $UFXPCODE(RPTR(EXPR$) SON,DAD)>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $PRNPCODE(STRING S)>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $PRVPCODE(RPTR(EXPR$)EE)>,
$EXPR, $mainpr);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $IFPCODE(RPTR(EXPR$) COND,A,B(NULL))>,
$EXPR, $mainpr);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $WHILEPCODE(RPTR(EXPR$)COND,STAT)>,
$EXPR, $mainpr);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $DOPCODE(RPTR(EXPR$)S,B)>,
$EXPR, $mainpr);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $FORPCODE(RPTR(SYMBOL)K;RPTR(EXPR$)I1,I2,I3,S)>,
$EXPR, $mainpr);
! *** PARSER PROCEDURES **** ;
DECLAR_PROC(<RECURSIVE PROCEDURE GTOKEN(BOOLEAN NONSTOP(TRUE))>,
$PARSER, $MAINPR∨$init∨$EXPR);
! if response is left out ASKUSER will wait for terminal input;
DECLAR_PROC(<PROCEDURE ASKUSER(STRING RESPONSE(null))>, $PARSER, $MAINPR∨$INPOUT∨$INIT);
DECLAR_PROC(<PROCEDURE PUSHDEVSTACK>, $PARSER, $MAINPR);
DECLAR_PROC(<PROCEDURE POPDEVSTACK>, $PARSER, $MAINPR);
DECLAR_PROC(<PROCEDURE MTYDEVSTACK>, $PARSER, $MAINPR∨$init);
DECLAR_PROC(<PROCEDURE NEWLINE>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE BOOLEAN PROCEDURE FINAL>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE READTO(STRING S)>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE INTEGER PROCEDURE READTILL(STRING CHARS)>, $PARSER, $MAINPR);
DECLAR_PROC(<STRING PROCEDURE NAMEFILE>, $PARSER, $MAINPR∨$INPOUT);
DECLAR_PROC(<SIMPLE STRING PROCEDURE FROMPART>, $PARSER, $MAINPR);
! DECLAR_PROC(<SIMPLE STRING PROCEDURE AXIS_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE DEV_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE ARM_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE HAND_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE SEMICOL_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE WORD_READ(STRING S)>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE MVFR_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE IDF_READ>, $PARSER, $MAINPR);
! **** HELP PROCEDURES **** ;
DECLAR_PROC(<PROCEDURE HLPMSG(INTEGER HELP1,HELP2(0))>, $$HELP, $MAINPR∧#HELP);
DECLAR_PROC(<PROCEDURE HLPDO(STRING ANSWER)>, $$HELP, $MAINPR∧#HELP);
! **** OUTPUT PROCEDURES **** ;
IFC $MAINPR∨$OUTPUT∨$INPOUT∨$DISPLY THENC
DECLAR_PROC(<STRING PROCEDURE CVSSYM(RPTR(SYMBOL)SYM; INTEGER MODE(TABLE_D))>,
$OUTPUT,$INPOUT∨$MAINPR∨$DISPLY);
DECLAR_PROC(<STRING PROCEDURE CVSYM(RPTR(SYMBOL)SYM; INTEGER MODE(TABLE_D))>,
$OUTPUT,$INPOUT∨$MAINPR∨$DISPLY);
DECLAR_PROC(<STRING PROCEDURE CVX(RANY T; INTEGER TYPE,MODE(TABLE_D))>,
$OUTPUT,$INPOUT∨$MAINPR∨$DISPLY);
ENDC
! ***** DISPLY ROUTINES ***** ;
IFC $DISPLY∨($MAINPR∧(#OUTPT∨#DISPL)) THENC
DECLAR_PROC(<PROCEDURE DPYOUT(INTEGER POG)>, FALSE∧$DISPLY, (#OUTPT∨#DISPL)∧$MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE INIDPY>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<SIMPLE PROCEDURE DPYDRAW>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<SIMPLE PROCEDURE DPYFREE>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<SIMPLE PROCEDURE OUTDPY>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<STRING PROCEDURE DPY_STRING(INTEGER TYPE)>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<RECURSIVE STRING PROCEDURE FRTREE(RPTR(FRAME) ND;INTEGER DEPTH)>,
$DISPLY, #OUTPT∨#DISPL);
! # of characters for frame tree;
DECLAR_VAR(<INTEGER $NCHAR>, $DISPLY, #OUTPT∨#DISPL);
ENDC
! ****** $INPOUT ROUTINES ******* ;
IFC ($MAINPR∧#OUTPT)∨$INPOUT∨$DISPLY THENC
DECLAR_PROC(<PROCEDURE FCLOSE>, $INPOUT, #OUTPT);
DECLAR_PROC(<PROCEDURE AL_CLOSE(STRING FILE )>, $INPOUT, #OUTPT);
DECLAR_PROC(<PROCEDURE WRITECODE(STRING FILE;
RPTR(SYMBOL) ELEMENT)>, $INPOUT, #OUTPT);
DECLAR_PROC(<PROCEDURE TTYSAVE>, $INPOUT, #OUTPT);
DECLAR_PROC(<STRING PROCEDURE FILE_STRING>, $INPOUT, #OUTPT);
DECLAR_PROC(<INTEGER PROCEDURE ISFILE(STRING FILE)>, $INPOUT, #OUTPT);
DECLAR_PROC(<STRING PROCEDURE DAT_STR>, $INPOUT, #OUTPT);
ENDC
DECLAR_PROC(<PROCEDURE UDATEFILE(INTEGER CHAN)>, $INPOUT, $PARSER);
! ******* INIT ROUTINES ********** ;
DECLAR_PROC(<PROCEDURE INIT>, $INIT, $MAINPR);
! ******** WRIST ROUTINES *************;
DECLAR_PROC(<INTEGER PROCEDURE RWRIST(STRING COMMAND; INTEGER VAL(0); STRING FILENAME(NULL))>,
FALSE, $MAINPR∧#WRIST);
! ********* MSSNGR ROUTINES ***********;
DECLAR_PROC(<PROCEDURE EVAL(RPTR(EXPR$)EE)>, $MSSNGR, $EXPR);
DECLAR_PROC(<PROCEDURE ALINIT>, $MSSNGR, $INIT);
DECLAR_PROC(<REAL PROCEDURE RFVAL(INTEGER WORD1,WORD2)>, $MSSNGR, $EXPR∨$PPCODE);
! ********* GATHER ROUTINES ************ ;
DECLAR_PROC(<PROCEDURE GRAPH(REAL ARRAY RDATA; INTEGER CTL,NPTS,SIZE)>,
FALSE, $MAINPR∨#GATHER);
! ********* PPCODE ROUTINES ************* ;
DECLAR_PROC(<PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1))>,
$PPCODE,#DEBUG∧($EXPR∨$MSSNGR∨$MAINPR));
! variable declarations ;
! **** BREAK TABLES ****** ;
DECLAR_VAR(<INTEGER $RETAB,$SKTAB,$SPCTAB,$SCNTAB,$NUMTAB,$ALFTAB,$FFTAB,
$DSHTAB,$LTTAB,$NLTTAB>, $MAINPR, $PARSER∨$INIT);
DECLAR_VAR(<INTEGER $DPYTAB>, $MAINPR, $PARSER∨$INIT∨$DISPLY);
DECLAR_VAR(<INTEGER $ERRTAB>, $MAINPR, $PARSER∨$INPOUT∨$INIT);
DECLAR_VAR(<INTEGER $BSKTAB,$RBTAB,$CRTAB>, $MAINPR, $PARSER∨$INPOUT∨$INIT∨$OUTPUT);
! **** DEFAULT MOVE FROM PREVIOUS **** ;
DECLAR_VAR(<STRING OLDOBJ>, $MAINPR, $PARSER);
! **** I/O TO POINTY ******* ;
! ESCAPE_I FLAG;
DECLAR_VAR(<BOOLEAN $ESC_I>, $MAINPR, $PARSER);
! if true output is required;
DECLAR_VAR(<BOOLEAN $OUT>, $MAINPR, $PARSER∨$INPOUT);
! if true read from disk file ;
DECLAR_VAR(<INTEGER $TTYCH>, $MAINPR, $PARSER∨$INPOUT);
! name of file for teletype input ;
DECLAR_VAR(<STRING $TTYFL>, $MAINPR, $INPOUT∨$INIT∨$DISPLY);
! total number of files defined ;
DECLAR_VAR(<INTEGER $TOTFL>, $MAINPR, $INPOUT∨$INIT);
! last file used for output ;
DECLAR_VAR(<STRING $ALFL>, $MAINPR, $INPOUT∨$INIT);
! current i/o device ;
DECLAR_VAR(<INTEGER DEVICE>, $MAINPR, $PARSER∨$INIT);
! end of file ? ;
DECLAR_VAR(<INTEGER $EOF>, $MAINPR, $PARSER∨$INPOUT);
! input channel for file input ;
DECLAR_VAR(<INTEGER $INPCH>, $MAINPR, $PARSER);
! **** DISPLAY ***** ;
! vertical position of the arrow;
DECLAR_VAR(<INTEGER $ARROW>, $MAINPR, $DISPLY);
! flag to update display ;
DECLAR_VAR(<INTEGER $ALLOW>, $MAINPR, $PARSER∨$INIT);
! strings for various parts of the display ;
DECLAR_VAR(<STRING ARRAY $DISPLAYLIST[#MIN:#MAX]>, $MAINPR, $DISPLY∨$EXPR);
IFC ($MAINPR ∨ $DISPLY∨$EXPR) THENC
DEFINE $SCLST= <$DISPLAYLIST[#SC]>,
$VTLST= <$DISPLAYLIST[#VT]>,
$RTLST= <$DISPLAYLIST[#RT]>,
$TRLST= <$DISPLAYLIST[#TR]>,
$FRLST= <$DISPLAYLIST[#FR]>,
$FNLST= <$DISPLAYLIST[#FN]>,
$MCLST= <$DISPLAYLIST[#MC]>;
ENDC
DECLAR_VAR(<STRING $OULST,$DFLST>, $MAINPR, $INPOUT∨$DISPLY∨$EXPR);
! **** SCANNER VARIABLES AND PARAMETERS **** ;
! the token itself ;
DECLAR_VAR(<STRING TOKEN>, $MAINPR, $PARSER∨$init∨$EXPR);
! type of last token read by GTOKEN;
DECLAR_VAR(<INTEGER #TOKEN>, $MAINPR, $PARSER∨$EXPR);
! index telling what type of reserved word ;
DECLAR_VAR(<integer res_class>, $PARSER, $MAINPR);
! true if the next token to be read is yet in TOKEN;
DECLAR_VAR(<BOOLEAN STOKEN>, $MAINPR, $PARSER∨$INIT∨$EXPR);
! more info on TOKEN ;
DECLAR_VAR(<INTEGER TOKENCLASS,TOKENINDEX,TOKENLEVEL>, $MAINPR, $PARSER∨$EXPR);
! pointer too relevant record in the symbol table ;
DECLAR_VAR(<RPTR(SCALAR,SYMBOL) TOKENPTR>, $MAINPR, $PARSER);
DECLAR_VAR(<RPTR(ANY_CLASS) TOKENPTR>, FALSE, $EXPR);
! current and remaining part of current line ;
DECLAR_VAR(<STRING $CLNE,$CLINR>, $MAINPR, $PARSER∨$INPOUT);
! prevent macro expansion;
DECLAR_VAR(<BOOLEAN NOEXPAND>, $MAINPR, $PARSER);
! output * or ****>>> depending on new statement ;
DECLAR_VAR(<BOOLEAN STBEGIN>, $MAINPR, $PARSER);
! do we want to print out the file being read in? ;
DECLAR_VAR(<BOOLEAN NEWFILE,FILEPRINT>, $MAINPR, $PARSER);
! ****** SYMBOL TABLE VARIABLES *** ;
DECLAR_VAR(<INTEGER ARRAY OFFSET[1:6,1:7]>, $MAINPR,$INIT∨$DISPLY∨$INPOUT);
DECLAR_VAR(<INTEGER $SYMOFF,$TSCOFF,$TTROFF>, $MAINPR,$INIT∨$EXPR);
DECLAR_VAR(<INTEGER $TMPOFF,$LEVEL>, $MAINPR,FALSE);
! DECLAR_VAR(<RPTR(EXPR$)$ARMPCODE,$BRMUPDATE,$BHDUPDATE>,$INIT, $EXPR);
! ***** MISCELLANEOUS VARIABLES ******* ;
DECLAR_VAR(<REAL $EPS>, $MAINPR, $INIT∨$OUTPUT);
DECLAR_VAR(<STRING $BLANK>, $MAINPR, $INPOUT∨$INIT∨$DISPLY);
DECLAR_VAR(<INTEGER $BRCHR>, $MAINPR, $INPOUT∨$OUTPUT);
DECLAR_VAR(<STRING $USERNAME>, $MAINPR, $INIT);
DECLAR_VAR(<STRING ARRAY $SYNMSG[0:35]>, $MAINPR∧FALSE, $PARSER);
DECLAR_VAR(<STRING ARRAY $DTYPE[0:7]>, $MAINPR∧FALSE,FALSE);
DECLAR_VAR(<STRING ARRAY $WRMSG[1:3]>, #WRIST∧FALSE, $MAINPR∧#WRIST);
! *** buffers and variables for communicating with elf **** ;
DECLAR_VAR(<INTEGER ARRAY $INBUF[1:500]>, $MSSNGR, $EXPR);
DECLAR_VAR(<REAL ARRAY $FPBUF[1:500]>, $MSSNGR, $EXPR);
DECLAR_VAR(<INTEGER $FPSIZ,$INTSIZ,$INTPTR,$FPPTR>, $MSSNGR, $EXPR);
DECLAR_VAR(<INTEGER ALEVENTOFF>, $INIT, $EXPR);
DECLAR_VAR(<INTEGER ARRAY ARROFF[#SC:#FR]>, $MAINPR, $MSSNGR∨$INIT∨$EXPR);
DECLAR_VAR(<INTEGER ARRAY VAROFF[#SC:#FR]>, $MAINPR, $MSSNGR∨$INIT∨$EXPR);
! file requirements;
REQUIRE_LOADMODULE($MAINPR∧#DISPL, <DISPLY[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR∧#OUTPT, <INPOUT[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR, <OUTPUT[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR, <MSSNGR[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR∧#HELP, <HELP[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR, <BEXPR[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR, <PARSE[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR∧#ARROW, <ARROW[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR, <INIT[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR∧#WRIST, <WRIST[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR∧#GATHER, <GRAPH[PNT,HE]>);
REQUIRE_LOADMODULE(#DEBUG, <PPCODE[PNT,HE]>);
! FAIL FILES;
REQUIRE_LOADMODULE($MAINPR∧#DISPL, <OUTDPW[PNT,HE]>);
REQUIRE "[][]" DELIMITERS;